home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / dvips / tex.lpro < prev    next >
Encoding:
Text File  |  1990-03-02  |  13.4 KB  |  401 lines
  1. % The following defines procedures assumed and used by program "dvips"
  2. % and must be downloaded or sent as a header file for all TeX jobs.
  3. % Originated by Neal Holtz, Carleton University, Ottawa, Canada
  4. %      <holtz@cascade.carleton.cdn>
  5. %      June, 1985
  6. %
  7. %   Hacked by tgr, July 1987, stripped down to bare essentials,
  8. %   plus a few new commands for speed.
  9. %
  10. %   Hacked by don, December 1989, to give characters top down and to
  11. %   remove other small nuisances; merged with tgr's compression scheme
  12. %
  13. % To convert this file into a downloaded file instead of a header
  14. % file, uncomment all of the lines beginning with %-%
  15. %
  16. %   To observe available VM, uncomment the following.
  17. %   (The first ten lines define a general 'printnumber' routine.)
  18. %
  19. % /VirginMtrx 6 array currentmatrix def
  20. % /dummystring 20 string def
  21. % /numberpos 36 def
  22. % /printnumber { gsave VirginMtrx setmatrix
  23. %   /Helvetica findfont 10 scalefont setfont
  24. %   36 numberpos moveto
  25. %   /numberpos numberpos 12 add def
  26. %   dummystring cvs show
  27. %   grestore
  28. %   } bind def
  29. % /showVM { vmstatus exch sub exch pop printnumber } def
  30. % /eop-aux { showVM } def
  31. %
  32. %-%0000000             % Server loop exit password
  33. %-%serverdict begin exitserver
  34. %-%  systemdict /statusdict known
  35. %-%  {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
  36. %-% if
  37.  
  38. /TeXDict 200 dict def   % define a working dictionary
  39. TeXDict begin           % start using it.
  40.  
  41. /bdf { bind def } def
  42.  
  43. % The output of dvips assumes pixel units, Resolution/inch, with
  44. % increasing y coordinates corresponding to moving DOWNWARD.
  45. % The PostScript default is big point units (bp), 72/inch, with
  46. % increasing y coordinates corresponding to moving UP; the
  47. % following routines handle conversion to dvips conventions. 
  48.  
  49. % Let the PostScript origin be (xps,yps) in dvips coordinates.
  50. /@rigin                 % -xps -yps @rigin -   establishes dvips conventions
  51.   { 72 Resolution div dup neg scale
  52.     translate
  53.   } bdf
  54.  
  55. % Here we assume the PostScript origin is at the bottom left corner
  56. % and that the paper is 11 inches high;
  57. % the dvips origin is 1 inch from top left corner;
  58. % hence if Resolution=300, we have (xps,yps)=(-300,3000). 
  59. /@letter                % setup for standard letter format
  60.   { Resolution dup -10 mul @rigin } bdf
  61.  
  62. /@landscape
  63.   { [ 0 1 -1 0 0 0 ] concat
  64.     Resolution dup @rigin } bdf
  65.  
  66. /@a4
  67.   { Resolution dup -10.6929133858 mul @rigin } bdf
  68.  
  69. /@legal
  70.   { Resolution dup -13 mul @rigin } bdf
  71.  
  72. /@manualfeed
  73.    { statusdict /manualfeed true put
  74.    } bdf
  75.  
  76.         % n @copies -   set number of copies
  77. /@copies
  78.    { /#copies exch def
  79.    } bdf
  80.  
  81. % Bitmap fonts are called fa, fb, ..., fz, f0, f1, ...; the maximum
  82. % supported by these macros is f999, but if you really go up that high
  83. % you need to increase the size of TeXDict.
  84. % The calling sequence for downloading font foo is
  85. %           /foo df chardef1 ... chardefn dfe
  86. % where each chardef is
  87. %           [<hexstring> wd ht xoff yoff dx] charno dc
  88.  
  89. /@FontMatrix [1 0 0 -1 0 0] def
  90. /@FontBBox [0 0 0 0] def
  91.  
  92. /dmystr (ZZf@@@) def       % define a place to put the new name
  93. /newname {dmystr cvn} bdf  % make it easy to get that name
  94. /df       % id df -         -- initialize a new font dictionary
  95.   { /fontname exch def
  96.     dmystr 2 fontname cvx (@@@@) cvs putinterval  % put name in template
  97.     newname 7 dict def              % allocate new font dictionary
  98.     newname load begin
  99.         /FontType 3 def
  100.     /FontMatrix @FontMatrix def
  101.     /FontBBox @FontBBox def
  102.         /BitMaps 256 array def
  103.         /BuildChar {CharBuilder} def
  104.         /Encoding IdentityEncoding def
  105.         end
  106.     fontname { /foo setfont }       %  dummy macro to be filled in
  107.        2 array copy cvx def         %  have to allocate a new one
  108.     fontname load                   %  now we change it
  109.        0 dmystr 6 string copy       %  get a copy of the font name
  110.        cvn cvx put                  %  and stick it in the dummy macro
  111.   } bdf
  112.  
  113. /dfe { newname dup load definefont setfont } bdf
  114.  
  115. % the following is the only character builder we need.  it looks up the
  116. % char data in the BitMaps array, and paints the character if possible.
  117. % char data  -- a bitmap descriptor -- is an array of length 6, of
  118. %          which the various slots are:
  119.  
  120. /ch-image {ch-data 0 get} bdf   % the hex string image
  121. /ch-width {ch-data 1 get} bdf   % the number of pixels across
  122. /ch-height {ch-data 2 get} bdf  % the number of pixels tall
  123. /ch-xoff  {ch-data 3 get} bdf   % number of pixels to right of origin
  124. /ch-yoff  {ch-data 4 get} bdf   % number of pixels below origin
  125. /ch-dx  {ch-data 5 get} bdf   % number of pixels to next character
  126.  
  127. /CharBuilder    % fontdict ch Charbuilder -     -- image one character
  128.      {save 3 1 roll exch /BitMaps get exch get /ch-data exch def
  129.       ch-data null ne
  130.       {ch-dx 0 ch-xoff ch-yoff neg
  131.        ch-xoff ch-width add ch-height ch-yoff sub
  132.        setcachedevice
  133.        ch-width ch-height true
  134.        [1 0 0 -1 -.1 ch-xoff sub ch-height ch-yoff sub .1 add]
  135. % begin code for uncompressed fonts only
  136.        {ch-image} imagemask
  137.      }if
  138.      restore
  139.   } bdf
  140. % end code for uncompressed fonts only
  141. % % here's the alternate code for unpacking compressed fonts
  142. %      /id ch-image def                          % image data
  143. %      /rw ch-width 7 add 8 idiv string def      % row, initially zero
  144. %      /rc 0 def                                 % repeat count
  145. %      /gp 0 def                                 % image data pointer
  146. %      /cp 0 def                                 % column pointer
  147. %      { rc 0 ne { rc 1 sub /rc exch def rw } { G } ifelse } imagemask
  148. %    }if
  149. %    restore
  150. % } bdf
  151. % /G { { id gp get /gp gp 1 add def
  152. %   dup 18 mod exch 18 idiv pl exch get exec } loop } bdf
  153. % /adv { cp add /cp exch def } bdf
  154. % /chg { rw cp id gp 4 index getinterval putinterval
  155. %         dup gp add /gp exch def adv } bdf
  156. % /nd { /cp 0 def rw exit } bdf
  157. % /lsh { rw cp 2 copy get dup 0 eq { pop 1 } { dup 255 eq { pop 254 }
  158. %     { dup dup add 255 and exch 1 and or } ifelse } ifelse put 1 adv } bdf
  159. % /rsh { rw cp 2 copy get dup 0 eq { pop 128 } { dup 255 eq { pop 127 }
  160. %     { dup 2 idiv exch 128 and or } ifelse } ifelse put 1 adv } bdf
  161. % /clr { rw cp 2 index string putinterval adv } bdf
  162. % /set { rw cp fillstr 0 4 index getinterval putinterval adv } bdf
  163. % /fillstr 18 string 0 1 17 { 2 copy 255 put pop } for def
  164. % /pl [
  165. %    { adv 1 chg } bind
  166. %    { adv 1 chg nd } bind
  167. %    { 1 add chg } bind
  168. %    { 1 add chg nd } bind
  169. %    { adv lsh } bind
  170. %    { adv lsh nd } bind
  171. %    { adv rsh } bind
  172. %    { adv rsh nd } bind
  173. %    { 1 add adv } bind
  174. %    { /rc exch def nd } bind
  175. %    { 1 add set } bind
  176. %    { 1 add clr } bind
  177. %    { adv 2 chg } bind
  178. %    { adv 2 chg nd } bind
  179. %    { pop nd } bind ] def
  180. % % end of code for unpacking compressed fonts
  181.  
  182.                % in the following, the font-cacheing mechanism requires that
  183.                 % a name unique in the particular font be generated
  184.  
  185. /dc            % char-data ch dc -    -- define character bitmap in current font
  186.   { /ch-code exch def
  187.     /ch-data exch def
  188.     newname load /BitMaps get ch-code ch-data put
  189.   } bdf
  190.  
  191. /bop           % bop -              -- begin a brand new page
  192.   {
  193.     gsave /SaveImage save def
  194.     0 0 moveto
  195.   } bdf
  196.  
  197. /eop           % - eop -              -- end a page
  198.   { % eop-aux  % -- to observe VM usage
  199.     clear SaveImage restore
  200.     showpage grestore
  201.   } bdf
  202.  
  203. /@start         % - @start -            -- start everything
  204.   {
  205.     /Resolution exch def
  206.     /IdentityEncoding 256 array def
  207.     0 1 255 {IdentityEncoding exch 1 string dup 0 3 index put cvn put} for
  208.   } bdf
  209.  
  210. /p { show } bdf        %  the main character setting routine
  211.  
  212. /RuleMatrix [ 1 0 0 -1 -.1 -.1 ] def % things we need for rules
  213. /BlackDots 8 string def
  214. /v {                   % can't use ...fill; it makes rules too big
  215.    gsave
  216.       currentpoint translate
  217.       false RuleMatrix { BlackDots } imagemask
  218.    grestore
  219. } bdf
  220. /a { moveto } bdf    % absolute positioning
  221. /delta 0 def         % we need a variable to hold space moves
  222. %
  223. %   The next ten macros allow us to make horizontal motions that
  224. %   are within 4 of the previous horizontal motion with a single
  225. %   character.  These are typically used for spaces.
  226. %
  227. /tail { dup /delta exch def 0 rmoveto } bdf
  228. /b { exch show tail } bdf      % show and tail!
  229. /c { show delta 4 sub tail } bdf
  230. /d { show delta 3 sub tail } bdf
  231. /e { show delta 2 sub tail } bdf
  232. /f { show delta 1 sub tail } bdf
  233. /g { show delta 0 rmoveto } bdf
  234. /h { show delta 1 add tail } bdf
  235. /i { show delta 2 add tail } bdf
  236. /j { show delta 3 add tail } bdf
  237. /k { show delta 4 add tail } bdf
  238. %
  239. %   These next allow us to make small motions (-4..4) cheaply.
  240. %   Typically used for kerns.
  241. %
  242. /l { show -4 0 rmoveto } bdf
  243. /m { show -3 0 rmoveto } bdf
  244. /n { show -2 0 rmoveto } bdf
  245. /o { show -1 0 rmoveto } bdf
  246. /q { show 1 0 rmoveto } bdf
  247. /r { show 2 0 rmoveto } bdf
  248. /s { show 3 0 rmoveto } bdf
  249. /t { show 4 0 rmoveto } bdf
  250. %
  251. %   w is good for small horizontal positioning.  x is good for small
  252. %   vertical positioning.  And y is good for a print followed by a move.
  253. %
  254. /w { 0 rmoveto } bdf
  255. /x { 0 exch rmoveto } bdf
  256. /y { 3 2 roll show moveto } bdf
  257. %
  258. %   The bos and eos commands bracket sections of downloaded characters.
  259. %
  260. /bos { /section save def } bdf
  261. /eos { clear section restore } bdf
  262.  
  263. end  % revert to previous dictionary
  264.  
  265.  
  266. %   This file also has the stuff from Paul Koning to implement the
  267. %   LN03 \special commands.  This is used by "changebars.sty".  
  268. %
  269.  
  270.  
  271. % /Resolution 300 def        % internal units are pixels (300/inch)
  272. /Inch {Resolution mul} def    % converts inches to internal units
  273.  
  274. /ln03$defs 10 dict def
  275. ln03$defs begin
  276. /points 256 array def
  277. 0 1 255 { points exch [ 0 0 ] put } for
  278. /linebuf 100 string def
  279.  
  280. % string -- postfix
  281. % defines /varnum in current dictionary
  282. /getvarnum
  283. { token not {stop} if            % get token, quit if none left
  284.   exec /varnum exch def            % execute it, save result
  285. } def
  286.  
  287. % string -- postfix
  288. % defines /varnum in current dictionary.
  289. % if input is of the form num/num2, uses num if Pagenum is odd, num2 if
  290. % it is even
  291. /get2varnum
  292. { { ( ) anchorsearch
  293.     { pop pop }
  294.     {exit} ifelse } loop        % eliminate leading spaces
  295.   ( ) search { exch pop } { () exch } ifelse  % look for terminating space
  296.                     % stack is now: -- postfix token
  297.   (/) search                % num1/num2 form?
  298.   { Pagenum 1 and 0 eq            % even page number?
  299.     { pop pop }                % yes, use second entry
  300.     { exch pop exch pop }        % use first number
  301.     ifelse
  302.   } if                    % now we have just the number wanted
  303.   cvi /varnum exch def            % convert and save it
  304. } def
  305.  
  306. % string default -- result
  307. /getdimension
  308. { exch dup length 1 sub 0 1 3 -1 roll    % get length, prepare to scan string
  309.   { pop dup 0 1 getinterval        % get first char
  310.     ( ) eq                % is it a space?
  311.     { dup length 1 sub 1 exch getinterval % yes, drop first char
  312.     } { exit } ifelse
  313.   } for
  314.   dup length 0 eq            % nothing but spaces?
  315.   { pop }                % yes, exit with default
  316.   { exch pop                % no, get rid of default
  317.     dup dup length 2 sub 2 getinterval    % get last two characters
  318.     1                    % default multiplier is 1
  319.     [[1 Inch 72 div (pt)]        % point
  320.      [1 Inch (in)]            % inch
  321.      [1 Inch 6 div (pc)]        % pica
  322.      [1 Inch 2.54 div (cm)]        % centimeter
  323.      [1 Inch 25.4 div (mm)]]        % milimeter
  324.     { aload pop                % get multiplier and string
  325.       3 index eq            % compare with suffix
  326.       { exch pop exit }            % match, use this multiplier
  327.       { pop }                % no match, pop unused multiplier
  328.       ifelse
  329.     } forall
  330.     exch pop                % get rid of suffix
  331.     exch dup length 2 sub 0 exch getinterval % get all but last 2 chars
  332.     cvr mul                % convert to a number, and form result
  333.   } ifelse
  334. } def
  335. end
  336.  
  337. /ln03:defpoint
  338. { ln03$defs begin
  339.   { currentfile linebuf readline
  340.     not {stop} if            % quit if premature eof
  341.     getvarnum                % get variable number
  342.     (\() search                % look for (
  343.     not {stop} if            % quit if missing
  344.     pop pop                % keep only string to its right
  345.     (,) search                % find separator
  346.     not {stop} if            % quit if missing
  347.     currentpoint pop            % default is current x
  348.     getdimension /x exch def        % process it and save result
  349.     pop                    % pop the comma
  350.     (\)) search                % search for )
  351.     not {stop} if            % quit if missing
  352.     currentpoint exch pop        % default is current y
  353.     getdimension [ x 3 -1 roll ]    % form [x y] pair
  354.     points varnum 3 -1 roll put        % update the variable
  355.     pop pop                % pop two results from search
  356.   } stopped
  357.   { (?Error in \\special ln03:defpoint) print pstack flush stop
  358.   } if
  359.   end
  360. } def
  361.  
  362. /ln03:connect
  363. { ln03$defs begin
  364.   { currentfile linebuf readline
  365.     not {stop} if            % quit if premature eof
  366.     get2varnum                % get one of two variable numbers
  367.     /firstvarnum varnum def        % save that one
  368.     get2varnum                % get another variable number
  369.     2 getdimension            % get dimension, default to 2
  370.     gsave                % save current graphics state
  371.     setlinewidth newpath        % initialize the line
  372.     points firstvarnum get        % get first variable
  373.     aload pop moveto            % get (x,y) pair, move there
  374.     points varnum get            % get second variable
  375.     aload pop lineto            % add a line to there
  376.     stroke grestore            % ... and that's all
  377.   } stopped
  378.   { (?Error in \\special ln03:connect) print pstack flush stop
  379.   } if
  380.   end
  381. } def
  382.  
  383. /ln03:resetpoints
  384. { ln03$defs begin
  385.   { currentfile linebuf readline
  386.     not {stop} if            % quit if premature eof
  387.     /firstvarnum 1 def            % default to 1-n rather than n-m
  388.     getvarnum                % get variable number
  389.     dup token                % is there anything else?
  390.     { pop pop /firstvarnum varnum def    % yes, save first number
  391.       getvarnum                % get another variable number
  392.     }
  393.     { pop }                % no, toss copy of string
  394.     ifelse
  395.     firstvarnum 1 varnum { points exch [ 0 0 ] put } for
  396.   } stopped
  397.   { (?Error in \\special ln03:resetpoints) print pstack flush stop
  398.   } if
  399.   end
  400. } def
  401.